#!/usr/bin/perl -wc

# See end of file for maintainer's notes.

package RFCMail::ESMTP::Server::Data::Spooler;

use strict;
use File::Spec::Functions qw(curdir rel2abs);

my $PRIVATE = __PACKAGE__;


sub init {
    my $self = shift;
    $self->SUPER::init(@_);
    $self->{incoming_dir} = curdir()
	if not defined($self->{incoming_dir});
    $self->{incoming_dir} = rel2abs($self->{incoming_dir});
    $self->{received_dir} = rel2abs($self->{received_dir})
	if defined($self->{received_dir});
    $self->{dirmode} = 0700
	if not defined($self->{dirmode});
}


sub data_start {
    my $self = shift;
    my $internal = RFCMail::ESMTP::Server::Data::Spooler::internal->new($self);
    $self->{$PRIVATE} = $internal;
    # Beware the self reference: $self->{$PRIVATE}->{server} == $self
    my $reply = $internal->data_start;
    return ($self->select_reply($self->SUPER::data_start(@_), $reply));
}


sub data_line {
    my $self = shift;
    $self->{$PRIVATE}->data_line(@_);
    $self->SUPER::data_line(@_);
}


sub data_finish {
    my $self = shift;
    my $reply = $self->{$PRIVATE}->data_finish;
    return ($self->select_reply($self->SUPER::data_finish(@_), $reply));
}


sub data_commit {
    my $self = shift;
    $self->{$PRIVATE}->data_commit;
    delete($self->{$PRIVATE});
    $self->SUPER::data_commit(@_);
}


sub data_abort {
    my $self = shift;
    delete($self->{$PRIVATE});
    $self->SUPER::data_abort(@_);
}


sub cleanup {
    delete($_[0]->{$PRIVATE});
    $_[0]->SUPER::cleanup;
}



package RFCMail::ESMTP::Server::Data::Spooler::internal;

use strict;
use IO::File;
use File::Spec::Functions qw(catdir catfile);
use File::Path qw(rmtree);
use RFCMail::Util::FileDump qw(dump_data_to_file);


sub new {
    my ($class, $server) = @_;
    return (bless {server => $server}, $class);
}


sub data_start {
    my ($self) = @_;
    my $server = $self->{server};
    my $tmpdir = do {
	my $trans_id = $server->{state}->{trans_id};
	my $incoming_dir = $server->{incoming_dir};
	defined($server->{received_dir}) ? catdir($incoming_dir, $trans_id)
	    : catdir($incoming_dir, "$trans_id.inc");
    };
    eval {
	# 1. Create "incoming" folder
	die "supposedly unique incoming dir '$tmpdir' already exists\n"
	    if -d $tmpdir;
	mkdir($tmpdir, $server->{dirmode})
	    or die "can't create incoming dir '$tmpdir': $!\n";
	$self->{tmpdir} = $tmpdir;
	# Existence of $self->{tmpdir} constitutes promise to clean it up.
	# 2. Dump state data in envelope file
	dump_data_to_file(catfile($tmpdir, 'env'), $server->{state});
	# 3. Open data file and write stamp
	my $datafile = catfile($tmpdir, 'data');
	my $data = IO::File->new($datafile, ">")
	    or die "can't create 'data' file '$datafile': $!\n";
	$data->print(join("\n", $server->data_stamp), "\n")
	    or die "can't print to 'data' file '$datafile': $!\n";
	$self->{data} = $data;
	# Existence of $self->{data} constitutes promise to close it.
    };
    if ($@) {
	$server->logmsg(e => __PACKAGE__."->data_start failed...", $@);
	return ([451, "Unable to accept data: error in local mail spool"]);
    }
    $server->logmsg(i => "accepting message in '$tmpdir'");
    $self->{status} = [250, "OK"];
    return ([354, "Start mail input; end with <CRLF>.<CRLF>"]);
}


sub data_line {
    my ($self, $line) = @_;
    return
	if not defined($self->{data});
    if (not $self->{data}->print($line, "\n")) {
	$self->{server}->logmsg(e => __PACKAGE__."->data_line failed...",
				"error writing data: $!");
	$self->abort;
	# I report the error "disk full" for the sake of simplicity
	$self->{status} = [452, "Requested action not taken: insufficient system storage"];
    }
}


sub data_finish {
    my ($self) = @_;
    if (exists($self->{data}) and not delete($self->{data})->close) {
	$self->{server}->logmsg(e => __PACKAGE__."->data_finish failed...",
				"error closing data file: $!");
	$self->{status} = [451, "Unable to store message data"];
	$self->abort;
    }
    return ($self->{status});
}


sub data_commit {
    my ($self) = @_;
    my $server = $self->{server};
    my $tmpdir = delete($self->{tmpdir});
    # Deleting $self->{tmpdir} terminates our promise to clean it up.
    return
	if not defined($tmpdir);
    my $finaldir = do {
	my $trans_id = $server->{state}->{trans_id};
	my $received_dir = $server->{received_dir};
	defined($received_dir) ? catdir($received_dir, $trans_id)
	    : catdir($server->{incoming_dir}, "$trans_id.rec");
    };
    if (rename($tmpdir, $finaldir)) {
	$server->logmsg(n => "message received and spooled at '$finaldir'");
    }
    else {
	$server->logmsg(c => __PACKAGE__."->data_commit failed...",
			"unable to move '$tmpdir' to '$finaldir': $!",
			"this situation must be resolved manually!");
    }
}


sub abort {
    my ($self) = @_;
    delete($self->{data})->close
	if exists($self->{data});
    my $tmpdir = delete($self->{tmpdir});
    if (defined($tmpdir)) {
	$self->{server}->logmsg(i => "removing partially spooled message in '$tmpdir'");
	eval { rmtree($tmpdir, 0, 1) };
	$self->{server}->logmsg(e => "unable to remove 'incoming' dir '$tmpdir': $@")
	    if $@;
    }
}


sub DESTROY { &abort; }


1;

__END__

# Maintainer's notes.

# This module is divided into two packages (call them HERE and
# HERE::internal to save keystrokes).  The purpose of the HERE package
# is to intercept the various function calls, call the SUPER version
# for layering purposes, and select between responses where
# appropriate.

# All the "real" work and internal state is in the HERE::internal
# package, an object instance of which is stored in $self->{HERE}.
# This sub-package has methods for data start, line, finish, and
# commit, which more or less mimic the semantics of the Server's
# similarly-named functions, except that they perform no layering on
# their own.  Note that the abort() method is semantically different
# from data_abort(), and is used only internally.  An "abort" happens
# either when one of the internal functions encounters a fatal problem
# and calls it, or if the object is DESTROYed before data_commit() is
# called.  Externally, data_abort() is implemented simply by causing
# the only reference to the internal object to expire.
